home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / PowerMacOberon feb96 / Source / StampElems.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1994-07-07  |  6.1 KB  |  163 lines  |  [.Ob./.Ob4]
  1. Syntax10.Scn.Fnt
  2. Syntax10b.Scn.Fnt
  3. MODULE StampElems;    (* CAS 26 Jun 92 *)
  4.     IMPORT
  5.         Files, Input, Display, Fonts, Texts, Oberon, Printer, TextFrames, TextPrinter;
  6.     TYPE
  7.         Elem = POINTER TO ElemDesc;
  8.         ElemDesc = RECORD (Texts.ElemDesc)
  9.             s: ARRAY 32 OF CHAR
  10.         END;
  11.         W: Texts.Writer;
  12.         month: ARRAY 12*3+1 OF CHAR;
  13.     PROCEDURE StrDispWidth (fnt: Fonts.Font; s: ARRAY OF CHAR): LONGINT;
  14.         VAR pat: Display.Pattern; width, i, dx, x, y, w, h: INTEGER; ch: CHAR;
  15.     BEGIN width := 0;
  16.         i := 0; ch := s[i];
  17.         WHILE ch # 0X DO
  18.             Display.GetChar(fnt.raster, ch, dx, x, y, w, h, pat); INC(width, dx);
  19.             INC(i); ch := s[i]
  20.         END;
  21.         RETURN LONG(width) * TextFrames.Unit
  22.     END StrDispWidth;
  23.     PROCEDURE DispStr (fnt: Fonts.Font; s: ARRAY OF CHAR; col, x0, y0: INTEGER);
  24.         VAR pat: Display.Pattern; i, dx, x, y, w, h: INTEGER; ch: CHAR;
  25.     BEGIN i := 0; ch := s[i];
  26.         WHILE ch # 0X DO
  27.             Display.GetChar(fnt.raster, ch, dx, x, y, w, h, pat);
  28.             Display.CopyPattern(col, pat, x0+x, y0+y, Display.replace);
  29.             INC(i); ch := s[i]; INC(x0, dx)
  30.         END
  31.     END DispStr;
  32.     PROCEDURE StrPrntWidth (fnt: Fonts.Font; s: ARRAY OF CHAR): LONGINT;
  33.         VAR width, dx, x, y, w, h: LONGINT; i: INTEGER; fno: SHORTINT; ch: CHAR;
  34.     BEGIN width := 0; fno := TextPrinter.FontNo(fnt);
  35.         i := 0; ch := s[i];
  36.         WHILE ch # 0X DO
  37.             TextPrinter.Get(fno, ch, dx, x, y, w, h); INC(width, dx);
  38.             INC(i); ch := s[i]
  39.         END;
  40.         RETURN width
  41.     END StrPrntWidth;
  42.     PROCEDURE PrntStr (fnt: Fonts.Font; s: ARRAY OF CHAR; x0, y0: INTEGER);
  43.     BEGIN Printer.String(x0, y0, s, fnt.name)
  44.     END PrntStr;
  45.     PROCEDURE Format (date: LONGINT; VAR s: ARRAY OF CHAR);
  46.         VAR i: INTEGER;
  47.         PROCEDURE Pair (x: LONGINT);
  48.         BEGIN
  49.             IF x >= 10 THEN s[i] := CHR(x DIV 10 + 30H); INC(i) END;
  50.             s[i] := CHR(x MOD 10 + 30H); INC(i)
  51.         END Pair;
  52.         PROCEDURE Label (m: LONGINT);
  53.         BEGIN m := (m-1)*3;
  54.             s[i] := month[m]; s[i+1] := month[m+1]; s[i+2] := month[m+2]; INC(i, 3)
  55.         END Label;
  56.     BEGIN i := 0;
  57.         Pair(date MOD 32); s[i] := " "; INC(i);
  58.         Label(date DIV 32 MOD 16); s[i] := " "; INC(i);
  59.         Pair(date DIV 512 MOD 128); s[i] := 0X
  60.     END Format;
  61.     PROCEDURE Copy (se, de: Elem);
  62.         VAR t, d: LONGINT;
  63.     BEGIN Texts.CopyElem(se, de); de.s := se.s
  64.     END Copy;
  65.     PROCEDURE Load (e: Elem; VAR r: Files.Rider);
  66.         VAR i: INTEGER; vers, ch: CHAR;
  67.     BEGIN Files.Read(r, vers); i := 0;
  68.         REPEAT Files.Read(r, ch); e.s[i] := ch; INC(i) UNTIL ch = 0X
  69.     END Load;
  70.     PROCEDURE Store (e: Elem; pos: LONGINT; VAR r: Files.Rider);
  71.         VAR t, d: LONGINT; i: INTEGER; ch: CHAR; s: ARRAY 32 OF CHAR;
  72.     BEGIN COPY(e.s, s); Oberon.GetClock(t, d); Format(d, e.s);
  73.         Files.Write(r, 1X); i := 0;
  74.         REPEAT ch := e.s[i]; Files.Write(r, ch); INC(i) UNTIL ch = 0X;
  75.         IF s # e.s THEN Texts.ChangeLooks(Texts.ElemBase(e), pos, pos+1, {}, NIL, 0, 0) END
  76.     END Store;
  77.     PROCEDURE PrepDraw (e: Elem; fnt: Fonts.Font; VAR dy: INTEGER);
  78.     BEGIN e.W := StrDispWidth(fnt, e.s); e.H := LONG(fnt.height) * TextFrames.Unit;
  79.         dy := fnt.minY;
  80.         IF dy > -2 THEN dy := -2 END
  81.     END PrepDraw;
  82.     PROCEDURE Draw (e: Elem; pos: LONGINT; fnt: Fonts.Font; col, x0, y0: INTEGER);
  83.         VAR p: TextFrames.Parc; beg: LONGINT; w: INTEGER;
  84.     BEGIN w := SHORT(e.W DIV TextFrames.Unit);
  85.         TextFrames.ParcBefore(Texts.ElemBase(e), pos, p, beg);
  86.         INC(y0, SHORT(p.dsr DIV TextFrames.Unit));
  87.         DispStr(fnt, e.s, col, x0, y0);
  88.         Display.ReplPattern(col, Display.grey1, x0, y0-1, w, 1, Display.replace)
  89.     END Draw;
  90.     PROCEDURE PrepPrint (e: Elem; fnt: Fonts.Font; VAR dy: INTEGER);
  91.     BEGIN e.W := StrPrntWidth(fnt, e.s); e.H := LONG(fnt.height) * TextFrames.Unit;
  92.         dy := SHORT(fnt.minY * LONG(TextFrames.Unit) DIV TextPrinter.Unit);
  93.         IF dy > -2 THEN dy := -2 END
  94.     END PrepPrint;
  95.     PROCEDURE Print (e: Elem; pos: LONGINT; fnt: Fonts.Font; x0, y0: INTEGER);
  96.         VAR p: TextFrames.Parc; beg: LONGINT;
  97.     BEGIN TextFrames.ParcBefore(Texts.ElemBase(e), pos, p, beg);
  98.         INC(y0, SHORT(p.dsr DIV TextPrinter.Unit));
  99.         PrntStr(fnt, e.s, x0, y0);
  100.         e.W := StrDispWidth(fnt, e.s)
  101.     END Print;
  102.     PROCEDURE Track (e: Elem; pos: LONGINT; x, y: INTEGER; keys: SET);
  103.     BEGIN
  104.         REPEAT Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y); Input.Mouse(keys, x, y)
  105.         UNTIL keys = {}
  106.     END Track;
  107.     PROCEDURE* Handle (e: Texts.Elem; VAR msg: Texts.ElemMsg);
  108.         VAR copy: Elem;
  109.     BEGIN
  110.         WITH e: Elem DO
  111.             IF msg IS Texts.CopyMsg THEN
  112.                 NEW(copy); Copy(e, copy); msg(Texts.CopyMsg).e := copy
  113.             ELSIF msg IS Texts.IdentifyMsg THEN
  114.                 WITH msg: Texts.IdentifyMsg DO msg.mod := "StampElems"; msg.proc := "Alloc" END
  115.             ELSIF msg IS Texts.FileMsg THEN
  116.                 WITH msg: Texts.FileMsg DO
  117.                     IF msg.id = Texts.load THEN Load(e, msg.r)
  118.                     ELSIF msg.id = Texts.store THEN Store(e, msg.pos, msg.r)
  119.                     END
  120.                 END
  121.             ELSIF msg IS TextFrames.TrackMsg THEN
  122.                 WITH msg: TextFrames.TrackMsg DO
  123.                     IF msg.keys = {1} THEN Track(e, msg.pos, msg.X, msg.Y, msg.keys) END
  124.                 END
  125.             ELSIF msg IS TextFrames.DisplayMsg THEN
  126.                 WITH msg: TextFrames.DisplayMsg DO
  127.                     IF msg.prepare THEN PrepDraw(e, msg.fnt, msg.Y0)
  128.                     ELSE Draw(e, msg.pos, msg.fnt, msg.col, msg.X0, msg.Y0)
  129.                     END
  130.                 END
  131.             ELSIF msg IS TextPrinter.PrintMsg THEN
  132.                 WITH msg: TextPrinter.PrintMsg DO
  133.                     IF msg.prepare THEN PrepPrint(e, msg.fnt, msg.Y0)
  134.                     ELSE Print(e, msg.pos, msg.fnt, msg.X0, msg.Y0)
  135.                     END
  136.                 END
  137.             END
  138.         END
  139.     END Handle;
  140.     PROCEDURE Alloc*;
  141.         VAR e: Elem;
  142.     BEGIN NEW(e); e.handle := Handle; Texts.new := e
  143.     END Alloc;
  144.     PROCEDURE Open (e: Elem);
  145.         VAR t, d: LONGINT;
  146.     BEGIN e.W := 5*TextFrames.mm; e.H := e.W; e.handle := Handle;
  147.         Oberon.GetClock(t, d); Format(d, e.s)
  148.     END Open;
  149.     PROCEDURE Insert*;    (** [font] **)
  150.         VAR s: Texts.Scanner; T: Texts.Text; e: Elem; fnt: Fonts.Font; copyover: Oberon.CopyOverMsg;
  151.     BEGIN Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(s);
  152.         IF (s.line = 0) & (s.class = Texts.Name) THEN fnt := Fonts.This(s.s) ELSE fnt := Oberon.CurFnt END;
  153.         NEW(e); Open(e);
  154.         T := TextFrames.Text(""); Texts.WriteElem(W, e); Texts.Append(T, W.buf);
  155.         Texts.ChangeLooks(T, 0, 1, {0}, fnt, 0, 0);
  156.         copyover.text := T; copyover.beg := 0; copyover.end := 1;
  157.         Oberon.FocusViewer.handle(Oberon.FocusViewer, copyover);
  158.         Texts.Delete(T, 0, T.len)
  159.     END Insert;
  160. BEGIN Texts.OpenWriter(W);
  161.     month := "JanFebMarAprMayJunJulAugSepOctNovDec"
  162. END StampElems.
  163.